home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #03 (Aug85-Sep85) / Basic / Prof. Mac Vol. 1 #10 / basic sort program (.txt)
AmigaBASIC Source Code  |  1985-07-22  |  4KB  |  139 lines
  1.  
  2.  
  3. REM Set up test data for Sort routine; do a timed call
  4. REM and verify that routine worked.
  5.     DIM Test$(599)  ' 600 strings
  6.     TotLen = 0
  7.     FOR I% = 0 TO 599
  8.         Test$(I%) = STR$(RND)
  9.         TotLen = TotLen + LEN(Test$(I%))
  10.     NEXT
  11.     PRINT USING "Average length of the 600 strings is ##.#";TotLen/600
  12.     PRINT "Sorting..."
  13.     Start = TIMER
  14.  
  15.     CALL Sort(Test$())
  16.  
  17.     PRINT "Sort took";TIMER-Start;"seconds; checking correctness..."
  18.     FOR I% = 0 TO 598
  19.         IF Test$(I%) > Test$(I%+1) THEN PRINT "Oops, didn't work!" : END
  20.     NEXT
  21.     PRINT "It worked!"
  22.     END
  23. REM ---------------Sort Subprogram follows---------------------
  24. REM
  25.     SUB Sort(S$(1)) STATIC
  26. REM
  27. REM Optimized Quicksort subprogram to sort
  28. REM an array of strings into ascending order.
  29. REM Algorithm adapted from:
  30. REM Sedgewick, Communications of the ACM, V21 N10, Oct. 1978
  31. REM and corrigendum, V22 N6, Jun. 1979
  32. REM Also see Chapter 9 of Sedgewick, "Algorithms",
  33. REM Addison-Wesley, 1983, ISBN 0-201-6672-6
  34. REM
  35. REM Rather than use recursion, use a stack of array partitions --
  36. REM The "Dimmed" kludge seems to be required to get a truly local array
  37. REM in a SUB that may be called more than once:
  38.     IF NOT Dimmed THEN DIM Stack%(15,2)   ' 15 handles 32,768 elements
  39.     Dimmed = 1
  40. REM
  41. REM Sedgewick's "M" parameter, which determines when to stop Quicksorting AND
  42. REM finish up with an insertion sort on entire array (an optimization):
  43.  
  44.     Insertion% = 10
  45.  
  46. REM
  47.     L% = LBOUND(S$)  ' "left" subscript
  48.     R% = UBOUND(S$)  ' "right" subscript
  49.     IF L% = R% THEN EXIT SUB ' One element is easy to sort!
  50.     IF R% - L% < Insertion% THEN GOTO InsertionSort
  51.     StackPtr% = 0
  52. REM Initialize for partitioning the subarray such that the partitioning
  53. REM element S$(L%) is the median of:  old S$(L%), S$(Middle%), S$(R%)
  54. PartInit:
  55.     Middle% = (L%+R%) / 2
  56. REM Lines beginning with "Temp$ =" are exchanges of array elements
  57.     Temp$ = S$(Middle%) : S$(Middle%) = S$(L%) : S$(L%) = Temp$
  58.     IF S$(L%+1) <= S$(R%) THEN GOTO P2
  59.     Temp$ = S$(L%+1) : S$(L%+1) = S$(R%) : S$(R%) = Temp$
  60. P2:
  61.     IF S$(L%) <= S$(R%) THEN GOTO P3
  62.     Temp$ = S$(L%) : S$(L%) = S$(R%) : S$(R%) = Temp$
  63. P3:
  64.     IF S$(L%+1) <= S$(L%) THEN GOTO Partition
  65.     Temp$ = S$(L%+1) : S$(L%+1) = S$(L%) : S$(L%) = Temp$
  66. Partition:
  67.     I% = L%+1
  68.     J% = R%
  69.     Partitioner$ = S$(L%)
  70. IncI:
  71.     I% = I% + 1
  72.     IF Partitioner$ >= S$(I%) THEN GOTO IncI
  73. DecJ:
  74.     J% = J% - 1
  75.     IF S$(J%) > Partitioner$ THEN GOTO DecJ
  76.     IF I% >= J% THEN GOTO GotIJ
  77.     Temp$ = S$(I%) : S$(I%) = S$(J%) : S$(J%) = Temp$
  78.     GOTO IncI
  79. GotIJ:
  80.     S$(L%) = S$(J%)
  81.     S$(J%) = Partitioner$
  82. REM Determine what to do next depending on relative and absolute
  83. REM sizes of subarrays
  84.     NL% = J% - L%          ' size of left subarray
  85.     NRM1% = R% - I%     ' (size of right subarray) - 1
  86.     IF NL% > NRM1% THEN GOTO BigLeft
  87. REM Right subarray is larger
  88.     IF NRM1% < Insertion% THEN GOTO CheckStack
  89.     IF NL% > Insertion% THEN GOTO LeftNext
  90. REM Partition right subarray next
  91.     L% = I%
  92.     GOTO PartInit
  93. REM Left subarray is larger (or equal)
  94. BigLeft:
  95.     IF NL% <= Insertion% THEN GOTO CheckStack
  96.     IF NRM1% >= Insertion% THEN GOTO RightNext
  97.     R% = J% - 1
  98.     GOTO PartInit
  99. REM "Push" right subarray, partition left subarray next
  100. LeftNext:
  101.     StackPtr% = StackPtr% + 1
  102.     Stack%(StackPtr%,1) = I%
  103.     Stack%(StackPtr%,2) = R%
  104.     R% = J% - 1
  105.     GOTO PartInit
  106. REM "Push" left subarray, partition right subarray next
  107. RightNext:
  108.     StackPtr% = StackPtr% + 1
  109.     Stack%(StackPtr%,1) = L%
  110.     Stack%(StackPtr%,2) = J% - 1
  111.     L% = I%
  112.     GOTO PartInit
  113. REM If stack not empty, pop and partition; else finish with insertion sort
  114. CheckStack:
  115.     IF StackPtr% = 0 GOTO InsertionSort
  116. REM Pop subarray specifier stack into L%, R%
  117.     L% = Stack%(StackPtr%, 1)
  118.     R% = Stack%(StackPtr%, 2)
  119.     StackPtr% = StackPtr% - 1
  120.     GOTO PartInit
  121. REM
  122. REM Insertion sort on entire array
  123. REM
  124. InsertionSort:
  125.     FOR I% = UBOUND(S$)-1 TO LBOUND(S$) STEP -1
  126.         IF S$(I%+1) > S$(I%) THEN GOTO Loop
  127.         Work$ = S$(I%)
  128.         J% = I% + 1
  129. Slide: S$(J%-1) = S$(J%)
  130.         J% = J% + 1
  131.         IF J% <= UBOUND(S$) THEN IF Work$ >= S$(J%) THEN GOTO Slide
  132.         S$(J%-1) = Work$
  133. Loop: NEXT
  134.  
  135.     END SUB
  136.  
  137. REM------------End of Sort subprogram------------------------
  138.  
  139.